
package Sgdb::ServicePane ;
use Sgdb::Utils qw ( :DEFAULT
                     tab_complete_filename
                     tab_complete_gdb_command
                     bind_history_mechanism
                     focus_on
                     recursive_mkdir
                     recursive_clean_dir
                     localconfig
                     getfilename
                     window_geometry
                     set_recent
                     get_recent
                     $slc_cred $slc_pass slc_weekly
                     target_symmetrix_chdir
                     target_symmetrix_list
                     change_font_size
                     foreach_target_symmetrix
                     create_window
                     ) ;

use warnings ;
use strict ;
use integer ;
use bytes ;

our $filename ;
my $gdbexec ;

our $dir_scratch ;
my  $dir_syren = "To add syren directory click 'Add Syren' ==>>" ;
my  $dir_reg ;
my  $dir_cvs ;
my  $dir_type ;
my  $last_symbol_file ;

my  $b_targets ;
my  $hostfile ;
my  $remote_addr ;
my  $remote_addr_is_hidden ;

our @source_directories ;

my %dirnames ;
my $alltar = 1 ;
my $allgdb = 1 ;
my $remote_image = '' ;
my $remote_compile_date ;
my $remote_compile_date_cache ;
my $target_was_switched = '' ;
my $textWidget ;

init () ;

sub init {

    $filename    = pref 'last-symbol-filename' ;
    $remote_addr = pref 'last-remote-address' ;
    $gdbexec     = pref 'last-gdb-exec' ;
    $dir_reg     = $ENV{PWD} ;

    hook_add ( 'new-symbol-file'           => [\&new_symbol_file           ] ,
               'target-was-switched'       => [\&target_was_switched       ] ,
               'target-was-detached'       => [\&target_was_detached       ] ,
               'invalid-symbol-file'       => [\&target_was_detached, 'all'] ,
               'add-swuch-window'          => [\&add_swuch_window          ] ,
               'add-swuch-pane'            => [\&add_swuch_pane            ] ,
               'everything-up-and-running' => [\&eval_sgdbinit             ] ,
               'new-chat-window'           => [\&hook_run, 'new-chat-target', \$remote_addr],
               'run-event-trace-app'       => [\&run_event_trace_app       ] ,
               'show-helper-window'        => [\&create_window, 'Sgdb::Helper', 'Sgdb Help', 'sgdbtk', 'sgdb-help'],
               # 'show-tpmonitor-window'     => [\&create_window, 'Sgdb::TPMonitor', 'TP Monitor', 'tpmonitor', 'tpmonitor'],
               # 'show-tpmonitor-window'     => [\&hook_run, 'tpmonitor-connect', \$remote_addr],
               ) ;


    if (my $pref = pref 'last-source-directories' ) {

        @source_directories =  split ' ', $pref ;
    }

    1;
}

sub new {

    my $self = shift or die "whoami" ;
    my $topf = shift or die "top frame needed" ;

    # Algo: shall I split this sub? hmm... it runs better this
    # way. I'll better try make readable in other ways.


    my $t = $textWidget = $topf->Scrolled ( 'Text',
                                            pref 'service-pane-text' ,
                                          );
    # Perlon: Text or ROText? or should I switch to a grid frame?

    # 'cache' variables
    my $separator     = "\n" . ('-' x 60) . "\n" ;
    my @pref_entry    = pref 'service-pane-entry' ;
    my @pref_button   = ('-width', 12, pref 'service-pane-button')  ;
    my $bg = $t -> cget ( '-background' ) ;


    {
        # text object configuration

        my $m = $t -> menu() ;
        $m -> delete(0, 'end') ;
        $m -> add ( 'command',
                    -label => 'Close',
                    -command  => [\&hook_run, 'close-current-source-pane' ],
                    ) ;

        pref_reconfigure ( 'service-pane-text' => $t ,
                           'pop-menu'          => $m ,
                           ) ;

        pref_tags $t, 'service-pane', qw/title glink glinked symm-loc/ ;

        $t -> tagBind ( 'glink', '<1>', [\&handle_clicked_glink, $t]) ;
        $t -> tagBind ( 'glink', '<Enter>', [$t, 'configure', -cursor => 'arrow'] ) ;
        $t -> tagBind ( 'glink', '<Leave>', [$t, 'configure', -cursor => 'xterm'] ) ;

        $t -> bind (        "<4>", [$t => 'yviewScroll', -3, 'units' ]) ; # mouse wheel up
        $t -> bind (        "<5>", [$t => 'yviewScroll', +3, 'units' ]) ; # and down
        $t -> bind (  "<Shift-4>", [$t => 'yviewScroll', -1, 'units' ]) ; # mouse wheel up
        $t -> bind (  "<Shift-5>", [$t => 'yviewScroll', +1, 'units' ]) ; # and down
        $t -> bind ("<Control-4>", [$t => 'yviewScroll', -1, 'page'  ]) ;
        $t -> bind ("<Control-5>", [$t => 'yviewScroll', +1, 'page'  ]) ;
    }
    # {   # credential / password 
    # 
    #     $t -> insert ( 'end',
    #                    "$separator SLC Credential/Password:" => 'title'
    #                  ) ;
    #     $slc_cred ||= pref 'last-slc-credential' ;
    #     my $bg = $t -> cget ( '-background' ) ;
    #     my $f = $t -> Frame ( -background => $bg ) ;
    # 
    #     $f -> Entry ( -textvariable => \$slc_cred ,
    #                   -width => 20 ,
    #                   @pref_entry
    #                 ) -> pack (qw/-side left -anchor w -padx 5/) ;
    # 
    #     $f -> Entry ( -textvariable => \$slc_pass,
    #                   -width => 10 ,
    #                   -show  => '*',
    #                   @pref_entry
    #                 ) -> pack (qw/-side left -anchor w -padx 5/) ;
    # 
    #     $f -> Button( -text => 'Weekly SLC' =>
    #                   -command => \&slc_weekly,
    #                   @pref_button
    #                 ) -> pack (qw/-side left -anchor w -padx 10/) ;
    # 
    #     $t -> windowCreate ( 'end',
    #                          -window => $f,
    #                          -stretch => 1,
    #                          -padx => 5,
    #                          ) ;
    # }
    {
        # set symbol file

        my $f = $t -> Frame ( -background => $t -> cget ( '-background' ) ) ;

        my $e = $f -> BrowseEntry  ( -textvariable => \$filename,
                                     -width => 57,
                                     -listcmd => \&fill_b_files ,
                                     @pref_entry
                             ) -> pack ( -side => 'left',
                                         -anchor => 'w',
                                       );

        bindkey 'C-o' => [\&focus_on, $e, ' Serv' ] => ' Open Symbol File ' ;
        focus_on $e;

        my $b = $f -> Button ( -text => 'Activate',
                               -command => \&activate_the_debugger,
                               @pref_button
                               ) ->  pack ( -side => 'left',
                                            -anchor => 'w',
                                            -padx => 5
                                            ) ;

        pref_reconfigure ('service-pane-entry'  => $e,
                          'service-pane-button' => $b,
                          ) ;

        hook_add 'invalid-symbol-file'       => [\&focus_on, $e] ;

        hook_add 'everything-up-and-running' => sub {

            return unless $b -> Exists() ;
            my $file = args 'file' or return ;
            $filename = $file ;
            if ( ord $file == ord '#' ) {
                hook_add 'everything-up-and-running' =>
                  sub { $b->invoke() } ;
            }
            else {
                $b->invoke()  ;
            }
        } ;

        $e -> bind ("<Return>", [$b, 'invoke']) ;
        $e -> bind ("<Tab>",    \&tab_complete_filename ) ;

        balloonset $e => <<DoC ;
 dir name    - use elf files from this directory
 blank       - locate elf by machine\'s checksum (after connecting)
 #<checksum> - locate elf by <checksum>
DoC
        $t -> insert ('end',
                      "$separator Symbol File:\n" => 'title',
                      ) ;

        $t -> windowCreate ( 'end',
                             -window => $f,
                             -stretch => 1,
                             -padx => 5,
                             ) ;

        $t -> insert ('end',
                                                     "\n " => 'regtext',
                      "Browse_File"      => 'glink', ", "  => 'regtext',
                      "Set_Default_File" => 'glink', # ", "  => 'regtext',
                      ) ;

    }
#     {
#         # connect symmetrix (or target or whatever)
# 
#         $t -> insert ('end',
#                       "$separator Remote Target:\n" => 'title',
#                       ) ;
# 
#         # main frame
#         my $frame = $t -> Frame ( -background => $bg
#                                   );
# 
#         # frame1: top of main frame
#         my $f1 = $frame -> Frame ( -background => $bg,
#                                    ) -> pack ( -side => 'top',
#                                                ) ;
# 
#         my $f = $f1 -> Frame( -background => $bg,
#                               -width => 60,
#                               ) -> pack ( -side => 'left',
#                                           -anchor => 'w',
#                                           ) ;
# 
#         balloonset <<DoC =>
# <name>       : connect machine <name>
# <name>-slc   : connect machine <name> after applying weekly slc
# <ip/net>     : connect machine at <ip>, or network name
# <ip/net>-slc : ... after applying weekly slc
# 
# <all above>:<dir>  : overwrite dir with <dir>
# DoC
#         $b_targets = $f -> BrowseEntry ( -variable => \$remote_addr ,
#                                          -listcmd  => \&fill_b_targets,
# #                                         -browsecmd => sub { focus_on $b_targets },
#                                          -background => $bg,
#                                          -width => 46,
#                                          @pref_entry
#                                          ) -> pack ( -side => 'left',
#                                                      -anchor => 'w',
#                                                      -expand => 1,
#                                                      -fill => 'x',
#                                                      ) ;
# 
#         bindkey 'C-l' => [\&focus_on, $b_targets, ' Serv' ] => 'Open new target' ;
# 
#         $hostfile = args ('hostfile') || getfilename ( pref 'last-remote-hosts-file' ) || $ENV{'HOME'} . "/.sgdbhosts" ;
# 
#         $f -> Label ( -text => ":",
#                       -background => $bg,
#                       ) -> pack ( -side => 'left',
#                                   ) ;
# 
#         my $socket = args ('target-port') || args ('dir') || 'D07A';
# 
# balloonset <<DoC =>
# Director to connect:
# D01a, D08c, D16b, etc - director
# L01a, L08c, L16b, etc - link cpu (symm7)
# ECM0, XCM1, etc       - if you don't know what it means,
#                         probably you don't need it.
# DoC
#         my $e = $f -> BrowseEntry ( -variable => \$socket ,
#                                     -background => $bg,
#                                     -width => 5,
#                                     @pref_entry
#                                   ) -> pack ( -side => 'left',
#                                               -anchor => 'w',
#                                             ) ;
#         {
#             my @sock = qw/ECM0 ECM1 CCM0 CCM1 XCM0 XCM1/ ;
#             foreach my $n ( map ("0$_", (1 .. 9) ), ( 10 .. 16) ) {
#                 push @sock, map { ( "D${n}$_", "L${n}$_") } ( 'a' .. 'd' ) ;
#             }
#             $e -> insert ( 'end' , @sock ) ;
#         }
# 
#         my $b = $f1 -> Button ( -text => 'Connect!',
#                                 -command => sub {
#                                     $remote_addr =~ /\-slc\b/i and slc_weekly() ;
#                                     my $cmd = localconfig 'qa-get-ip-by-name', $remote_addr ;
#                                     $cmd ||= $remote_addr =~ /(\S+)/ ? $1 : $remote_addr || '' ;
#                                     $cmd .= ":$1" if ($ENV{UsePort_sgdb} || '') =~ /^(\d+)$/ ;
#                                     $cmd .= ":$socket" if $socket and $cmd !~ /:[a-zA-Z]/;
#                                     return telthemloud "can't determine address/socket" unless $cmd ;
#                                     hook_run_lock ( 'connect-target', pref ( 'last-target-type' ) || 'symmetrix' , $cmd ) ;
#                                     hook_run 'set-title', 'symm', $remote_addr ;
#                                 },
#                                 @pref_button
#                                 ) -> pack ( -side => 'left',
#                                             -anchor => 'w',
#                                             -padx => 5,
#                                             ) ;
# 
# 
# 
# 
#         $b_targets -> bind ('<Return>', [$b => 'invoke' ] ) ;
#         pref_reconfigure ( 'service-pane-entry'  => $b_targets => $e ,
#                            'service-pane-button' => $b,
#                            ) ;
# 
# 
#         hook_add 'everything-up-and-running' => sub {
# 
#             # Algo: this hook will run only once, therefore I don't mind _ANON_ code
# 
#             if ( $ENV{symmipSeCrEtIP} ) {
#                 $remote_addr_is_hidden = 1;
#                 $b_targets -> configure ( -show => '*' ) ;
#                 $remote_addr = $ENV{symmipSeCrEtIP} ;
#                 unless ($ENV{NOSYMMNAT}) {
#                     busy ;
#                     my $msg = localconfig 'call-symmnat', $remote_addr =~ /(\S+)/ ;
#                     unbusy ;
#                     if ( $msg =~ /^Error/ ) { telthemloud $msg }
#                     else {                    telthem     $msg }
#                 }
#                 return $b -> invoke() ;
#             }
# 
#             my $targ = args 'target' or return ;
#             $remote_addr = $targ ;
#             $b->invoke () ;
# 
#             my $dir = lc args 'dir' or return ;
#             $socket = $dir ;
#             $b->invoke() ;
# 
#         } ;
# 
#         $e -> bind ("<Return>", [$b, 'invoke']) ;
# 
#         $t -> windowCreate ( 'end',
#                              -window => $frame,
#                              -stretch => 1,
#                              -padx => 5,
#                              ) ;
# 
#         $t -> insert ( 'end',
#                                                 "\n "  => 'regtext',
#                        'From_File'   => 'glink', ', '  => 'regtext',
#                        'Edit_File'   => 'glink', ', '  => 'regtext',
#                        'Add_To_File' => 'glink', ', '  => 'regtext',
#                        'Set_Default_Address' => 'glink', "\n ", => 'regtext',
#                        'Pre_SymmIp'  => 'glink', "\n " => 'regtext',
#                        ) ;
#     }
#     {
#         # target symmetrix
# 
#         $t -> insert ( 'end',
#                        "$separator Symmetrix Target:  \n" => 'title',
#                        ) ;
#         $t -> markSet    ('SymmName', 'end - 2 c') ;
#         $t -> markGravity('SymmName', 'left') ;
# 
#         my $dirs = $t -> Frame ( -background => $t -> cget ( '-background' ),
#                                  -borderwidth => 2,
#                                  -relief => 'sunken',
#                                  ) ;
# 
#         hook_add ('connect-target', [\&connect_target, $dirs],
#                   # 'connect-target', [\&fill_name_and_loc, $t, \$remote_addr],
#                  ) ;
# 
#         $t -> windowCreate ( 'end',
#                              -window => $dirs,
#                              -stretch => 1,
#                              -padx => 5
#                              ) ;
# 
#         my $f = $t -> Frame ( -background => $t -> cget ( '-background' ) ) ;
# 
#         my $cmd ;
# 
#         my $e = $f -> Entry  ( -textvariable => \$cmd,
#                                -width => 60,
#                                @pref_entry
#                                ) -> pack ( -side => 'left',
#                                            -anchor => 'w',
#                                            );
# 
#         $e -> bind ( "<Tab>", \&tab_complete_gdb_command ) ;
#         my $hcb = bind_history_mechanism ( $e, \$cmd ) ;
# 
#         my $b = $f -> Button ( -text => 'Multi Cmd',
#                                -command => sub {
#                                    $hcb -> ( $cmd ) ;
#                                    hook_run_lock 'exec-multi-target-cmd', $allgdb, $alltar, $cmd ;
#                                    $cmd = '' ;
#                                },
#                                @pref_button
#                                ) ->  pack ( -side => 'left',
#                                             -anchor => 'w',
#                                             -padx => 5
#                                             ) ;
# 
#         $e -> bind ( '<Return>', [$b, 'invoke']) ;
# 
#         balloonset $e => <<DoC ;
# Enter the command to be executed as Multi Cmd. It will 
# be sent to all running gdb sessions/targets(directors), 
# depending on selected check-boxes; All Debuggers, All Targets.
# DoC
# 
#         pref_reconfigure ('service-pane-entry'  => $e,
#                           'service-pane-button' => $b,
#                           ) ;
# 
#         $t -> insert ( 'end',
#                                                  "\n " => 'regtext',
#                        'Connect_All' => 'glink', ', '  => 'regtext',
#                        'Connect_Same'=> 'glink', ', '  => 'regtext',
#                        'Disconnect'  => 'glink', ', '  => 'regtext',
#                        'Disconnect_All'=> 'glink',
#                                             "\n All: " => 'regtext',
#                        'tstart'      => 'glink', ', '  => 'regtext',
#                        'tstop'       => 'glink', ', '  => 'regtext',
#                        'tfind'       => 'glink', ', '  => 'regtext',
#                        'tstatus'     => 'glink', "\n"  => 'regtext',
#                        ) ;
# 
#         $t -> windowCreate ( 'end',
#                              -window => $f,
#                              -stretch => 1,
#                              -padx => 5
#                              ) ;
# 
#         my $c1 = $t -> Checkbutton ( -variable => \$alltar ) ;
#         my $c2 = $t -> Checkbutton ( -variable => \$allgdb ) ;
# 
#         $t -> insert ( 'end', "\n " => 'regtext' ) ;
#         $t -> windowCreate ( 'end', -window => $c1 ) ;
#         $t -> insert ( 'end', " All Targets  " ) ;
#         $t -> windowCreate ( 'end', -window => $c2 ) ;
#         $t -> insert ( 'end', " All Debuggers\n" ) ;
#     }
    {
        # set source directories

        $t -> insert ('end',
                      "$separator Source Files Directories Lookup:\n" => 'title',
                      ) ;

        # main frame
        my $frame = $t -> Frame ( -background => $bg
                                  );
        # frame1: top of main frame
        my $f = $frame -> Frame ( -background => $bg,
                                  ) -> pack ( -side => 'top',
                                              ) ;

        my $l = $f -> Listbox ( -height => 5,
                                -width => 60,
                                @pref_entry
                                ) -> pack ( -side => 'left',
                                            -anchor => 'w',
                                            -padx => 0,
                                            -pady => 4,
                                            );

        pref_reconfigure 'service-pane-entry' ,
#       balloonset $l => <<DoC ;
#Sgdb will also search for source
#files in all directories
#listed in this pane.
# DoC

        $l -> insert ( 0 , @source_directories ) ;

        # frame2: right of frame1
        $f = $f -> Frame ( -background => $bg,
                           ) -> pack ( -side => 'left',
                                       -fill => 'y',
                                       -expand => 1,
                                       ) ;

        pref_reconfigure 'service-pane-button',

        balloonset <<DoC =>
Remove the selected
directory from the
search list!
DoC
          $f -> Button ( -text => 'Delete',
                         -command => sub {
                             $l -> delete( 'active' ) ;
                             @source_directories = $l -> get (0 => 'end' ) ;
                             $l -> selectionSet ( 'active' )
                         },
                         @pref_button
                       ) -> pack ( -side => 'top',
                                   -anchor => 'w',
                                   -padx => 5,
                                   -pady => 5,
                                 ) ;

        pref_reconfigure 'service-pane-button',
        balloonset <<DoC =>
Raise the selected
directory to change
the search order.
DoC
          $f -> Button ( -text => 'Up',
                         -command => sub {
                             my $n = $l -> index ( 'active' ) ;
                             return $l -> bell() unless $n  ;
                             $l -> insert ( $n - 1, $l -> get ( $n ) ) ;
                             $l -> delete ( $n + 1 ) ;
                             @source_directories = $l -> get ( 0 => 'end' ) ;
                             $l -> activate ( $n - 1 ) ;
                             $l -> selectionSet( $n - 1 ) ;
                         },
                         @pref_button
                       ) -> pack ( -side => 'top',
                                   -anchor => 'w',
                                   -padx => 5,
                                   -pady => 5,
                                 ) ;
        # frame3: after frame1
        $f = $frame -> Frame ( -background => $bg,
                               ) -> pack ( -side => 'top',
                                           -fill => 'x',
                                           -expand => 1,
                                           ) ;

        my $e = $f -> Entry ( -textvariable => \$dir_reg,
                              -width => 60,
                              @pref_entry
                              ) -> pack ( -side => 'left',
                                          -anchor => 'w',
                                          ) ;

        pref_reconfigure 'service-pane-entry',
        balloonset $e => 'New directory for source file lookup.' ;

        $e -> bind ("<Tab>",    \&tab_complete_filename ) ;

        $dir_type = 'Add Dir' ;
        my $b = $f -> Button ( -textvariable => \$dir_type ,
                               -command => [\&new_directroy_to_list, $l] ,
                               @pref_button
                               ) -> pack ( -side => 'left',
                                           -anchor => 'w',
                                           -padx => 5
                                           ) ;

        pref_reconfigure 'service-pane-button',
        balloonset $b => <<DoC ;
Add a new directory
to the lookup list.
DoC

        # frame4: after frame3
        $f = $frame -> Frame ( -background => $bg ,
                               ) -> pack ( -side => 'top',
                                           -fill => 'x',
                                           -expand => 1,
                                           ) ;
        my $act = sub {
            my ( $msg, $var, $state ) = @_ ;
            hook_run 'display-in-statusbar', $msg ;
            $e -> configure ( -textvariable => $var, -state => $state) ;
        } ;

        foreach my $rb (['Simple',
                         'Add Dir',
                         [$act, '', \$dir_reg, 'normal'],
                         "regular directory",
                         ],
#                      ['Scratch',
#                       'Set Scratch',
#                       [$act, 'Set Scratch Directory for sgdb', \$dir_scratch, 'normal'],
#                       'Scratch directory for temporary sources (from zip, etc.)'
#                       ],
                        # ['Syren',
                        #  'Add Syren' ,
                        #  [$act, "Just click 'Add Syren' to activate ", \$dir_syren, 'disabled' ],
                        #  "Check this field to make Sgdb search Syren workspaces too!"
                        # ],
                        # ['CVS',
                        #  'Add CVS' ,
                        #  [$act, "Choose directory containing valid CVS/Entries file", \$dir_cvs, 'normal' ] ,
                        #  "Check this filed to make Sgdb search the CVS/Entries upper directory!"
                        #  ],
                        ) {

            my ( $txt, $val, $cmd, $doc )  = @$rb ;

            balloonset
                $f -> Radiobutton ( -text => $txt ,
                                    -value => $val ,
                                    -variable => \$dir_type,
                                    -command => $cmd ,
                                    -background => $bg ,
                                    -width => 6,
                                    ) -> pack ( -side => 'left'
                                                ) => $doc ;
        }

        hook_add ( 'new-symbol-file' , [\&update_source_for_new_symbol_file, $l, $b ] ) ;

        pref_reconfigure 'service-pane-entry',
        balloonset $e => <<DoC ;
The default Sgdb lookup directory - where you have started Sgdb!
DoC
        $e -> bind ("<Tab>",    \&tab_complete_filename ) ;

        $t -> windowCreate ( 'end',
                             -window => $frame,
                             -stretch => 1,
                             -padx => 5,
                             ) ;

    }
    {
        # set gdb exec
        my $f = $t -> Frame ( -background => $t -> cget ( '-background' ) ) ;

        my $e = $f -> BrowseEntry ( -variable => \$gdbexec,
                                    -width => 60,
                                    @pref_entry
                                    ) -> pack ( -side => 'left',
                                                -anchor => 'w',
                                                ) ;

        $e -> insert ( 'end',
                       'auto',
                       split (/\s*;\s*/, pref 'last-gdb-exec-list' ),
                       localconfig 'list-all-gdb' ,
                       ) ;

        pref_reconfigure 'service-pane-entry' ,
        balloonset $e => <<DoC ;
Leave as 'auto' to let sgdb pick debugger
Otherwise, specify your own.
DoC
        $e -> bind ("<Tab>",    \&tab_complete_filename ) ;

        $t -> insert ('end',
                      "$separator Set Debugger \n" => 'title',
                      ) ;

        $t -> windowCreate ( 'end',
                             -window => $f,
                             -stretch => 1,
                             -padx => 5,
                             ) ;
        $t -> insert ('end',
                      "\n" => 'regtext',
                      "Set_Default_Debugger" => 'glink', ', ' => 'regtext',
                      "Add_To_List"          => 'glink'
                      ) ;
    }

#     bindkey 'C-i' => [\&hook_run, 'add-inlines-right-pane' ] ;
    bindkey 'C-i' => [\&hook_run, 'add-swuch-pane' ]  , 'Open Swuch Pane' ;
    bindkey 'C-I' => [\&hook_run, 'add-swuch-window' ] , 'Open Swuch Window' ;
    bindkey '<F1>' => [\&hook_run, 'show-helper-window'], 'Show Help Window' ;

    # focus_on $b_targets ;
    $t -> configure ( -state => 'disabled' ) ;
    $t ;
}

sub top_menu_recent_files {

    # add recent to top menu
    my $m = shift ;
    my $sm = $m -> Menu ( -tearoff => 0,
                          pref 'top-menu'
                          ) ;
    $m -> add ( 'cascade',
                -label => 'Recent Files',
                -menu => $sm ,
                ) ;

    $sm -> configure ( -postcommand =>
                       sub {

                           $sm -> delete( 0, 'end' ) ;
                           foreach my $f ( get_recent 'recent-symbol-files', 'recent/sgdb' ) {
                               $sm -> add ( 'command' ,
                                            -label => $f ,
                                            -command => sub { $filename = $f }
                                            ) } }
                     ) ;
}

sub top_menu_recent_targets {

    my $m = shift ;
    my $sm = $m -> Menu ( -tearoff => 0,
                          pref 'top-menu'
                          ) ;

    $m -> add ( 'cascade',
                -label => 'Recent Targets',
                -menu => $sm ,
                ) ;

    $sm -> configure ( -postcommand =>
                       sub {

                           $sm -> delete( 0, 'end' ) ;
                           foreach my $f ( get_recent 'recent-remote-addresses', 'recent/sgdb' ) {
                               $sm -> add ( 'command' ,
                                            -label => $f ,
                                            -command => sub { $remote_addr = $f }
                                            ) } } ) ;
}

sub activate_the_debugger {

    busy ;

    $filename = shift if @_ ;
    my ($f) = $filename =~ /^\s*(.*?)\s*$/ ;

    # if (not $f or $f =~ /^\s*\#\s*(\w*)/ ) {
    # 
    #     $f = date_lookup_quick( lc $1 || '#' ) ;
    # 
    #     unbusy ;
    # 
    #     return unless $f ;
    #     $filename = $f ;
    #     return ;
    # }
    # else {
        $f = getfilename $f ;
    # }
    unbusy and return telthemloud "the file '$f' does not exists"
      unless -e $f ;
    unbusy and return telthemloud "the file '$f' is not readable"
      unless -r _ ;

    my @args = ('file' => $f ) ;

    if ($gdbexec and lc ((split ' ', $gdbexec)[0]) ne 'auto' ) {

        telthem "using '$gdbexec' as a debugger.." ;
        push @args, 'execfile' => $gdbexec ;
    }

    hook_run_lock 'create-new-gdb', @args, @_  ;

    unbusy ;
    1 ;
}

sub get_image_directly {

    my $cmd = shift ;
    my ($ip, $port, $dir) = map {/^\s*(.*?)\s*$/ } split ':', $cmd ;
    ($dir,$port) = ($port,$dir) unless $dir ;
    if ($dir =~ /^\d+[a-d]$/ or
        $dir =~ /^k/i ) {
        return
    }

    my $img ;
    eval {                      # sgdb socket
        require SWUCH or die "can't use SWUCH\n";
        my $symm = new SWUCH ( $ip , 1) or die "Cannot connect SWUCH: $!\n" ;
        $symm -> import_sgdb() ;
        for (0 .. 10) {
            next unless $symm -> {symm_config} ;
            # 4: D08E-SF-DD D07A-DF-DD D07F-SF-DD D08B-DF-DD D07E-SF-DD D08A-DF-DD D08H-SF-DD D07H-SF-DD D08C-DF-DD D08F-SF-DD D07D-DF-DD D07G-SF-DD D08D-DF-DD D07C-DF-DD D07B-DF-DD D08G-SF-DD
            last if 0 < index lc ($symm -> {symm_config}), lc (" $dir-") ;
            $symm -> {symm_config} =~ / (D\w\w\w)-/ and $dir = $1 ;
            $symm -> cycle(0.1) ;
            last ;
        }
#         telme 'using chdir' if $use_sgdb_chdir = ($symm->{symm_config}||'') =~ /^\s*(\d+):/ and $1 >= 5 ;
        $img = $symm -> sgdb_stub_get_image( $dir ) or die "cannot get stub image\n" ;
        $symm -> destroy () ;
    } ;
    telme "stub: $@" if $@ ;
    return $img if $img ;

    eval {                      # image
        require SGDBDirect or die "can't use SGDBDirect\n";
        my $symm = new SGDBDirect( $ip, $dir ) or die "cannot connect SGDBDirect: $!\n" ;

            $img = $symm -> get ('qIMG') ;
        if ($img) {
            $img = "IMG: ;$img"
        }
        else {
            $img = $symm -> get ('qImg') or die "cannot read symm-image\n" ;
            $img =  "Img: ;Version:$img" ;
        }
        my $blt = $symm -> get ('qIbi') || '' ;
            $img = "$img;$blt\n" ;
    } ;
    telme "IMG: $@" if $@ ;
    return  $img if $img and $img !~ /Target does not support this command/ ;
    #    localconfig 'symm-image', $ip, $dir, $slc_pass, $slc_cred ;
    ''
}

sub image_from_active_gdb {
    my $img ;
    my $IMG = gdb_exec_quiet( 'mai pa qIMG' ) ;
    if($IMG =~ /received:\s*\"(.*)\"/ and $1 ) {
        $img = $1 ;
    }
    else {
        $img = gdb_exec_quiet( 'symm-image' ) ;
    }
    my $blt = gdb_exec_quiet( 'symm-build-info' ) ;
    "$img;$blt"
}

sub fill_name_and_loc_line($) {
    my $a = shift ;
    $a =~ /^\s*\#?([\w\.]+)/ or return ;
    my $s = uc $1 ;
    my $f = localconfig 'symm-locale-file' or return telme "fileless" ;
    my $re = qr/^$s:/ ;
    open  F, $f or return telme "can't open $f: $!" ;
    while (<F>) {
        /$re/ or next ;
        /$s\:[^\:]*:([^\:]+)/ or return telme "bad symms.dat format: $_" ;
        my $l = $1 ;
        close F ;
        return "$s in $l" ;
    }
    close F;
    $s ;
}

sub fill_name_and_loc {
    # my ($t, $a) = @_ ;
    # $a = $$a if ref $a ;
    my ($t, $a) = ($textWidget, $remote_addr) ;
    $t -> configure ( -state => 'normal' ) ;
    $t -> delete ('SymmName', 'SymmName lineend' ) ;
    $t -> insert (SymmName => fill_name_and_loc_line($a) || '', 'symm-loc' ) ;
    $t -> configure ( -state => 'disabled' ) ;
}

sub connect_target {

    my ($f, $type, $cmd ) = @_ ;
    return telthemloud 'bad target name' unless $cmd ;
    # Algo: this way one might set type to '' and use flexible command

    my ($direct, $res) ;

    if (exists $dirnames{ $cmd } ) {
        return $dirnames{ $cmd } -> invoke() ;
        # Algo: Does the user wants to switch or to reconnect? using the Occam's
        # razor, switching appears to be less noisy..
    }
    elsif ($type eq 'symmetrix' and
           my $image = get_image_directly ($cmd) ) {
        $res = '0x' ;
        $direct = $image ;
        telthem "getting image bypassing gdb: '$direct'" ;
    }
    else {

        hook_run ( 'create-new-gdb',
                   ( ($gdbexec and lc ((split ' ', $gdbexec)[0]) ne 'auto' ) ?
                     ('execfile' => $gdbexec ) :
                     ('default-target' => 'ppc')
                   )
                 ) ;
        # this is and empty gdb (no symbol-file) that should be used as a dummy for
        # communication.
    }
    $res   ||= gdb_exec ("target $type $cmd $slc_cred $slc_pass") || '' ;
    # if ($res =~ /SLC credential\/password required/ and ! $slc_cred and ! $slc_pass ) {
    #     slc_weekly() ;
    #     $res = gdb_exec ("target $type $cmd $slc_cred $slc_pass") || '' ;
    # }
    if ($res =~ /SLC credential\/password required/) {
        return telthemloud $res
    }
    new_target_remote () if $res =~ /^0x|exc0/ and ! $remote_addr_is_hidden ;

    return unless $type eq 'symmetrix' ;
    # Algo:  Imust  allow bypasses for unique special features

    fill_name_and_loc() ;
    hook_run 'new-chat-window' if $remote_addr_is_hidden ;
    return if $res =~ /Director Not Responding/ ;

    foreach my $dir ( $f -> children ) {
        eval { $dir -> gridForget() ;
               $dir -> destroy() ;
           }
    }
    %dirnames = () ;

    $remote_image = $direct || image_from_active_gdb() ;

    ($remote_compile_date) = $remote_image =~ /Date:(.*?)\;/ ;

    my ($target, $director, $newformat) = $cmd =~ /(.*):(l?\d+\w|([DL]\d\d[a-z]|[XCE]CM[01]))\s*\z/gi or
      return telthem "can't determine target address";
    $target = lc $target ;

    if ( $res =~ /This is RMS machine/ ) {
# This is RMS machine: 
# symm1=187990123  IPCPORT:7001 SILPORT:4221 REMOTEPORT:1302 DEBUGPORT:1401;
# symm2=187990126  IPCPORT:7004 SILPORT:4220 REMOTEPORT:1301 DEBUGPORT:1400;
        my $i = 0 ;
        while ( $res =~ /(sym\S+).*?DEBUGPORT:(\d+)/g ) {
            my ( $n, $p ) = ( $1, $2 ) ;
            $f -> Button ( -text => "RMS:   $n" ,
                           -width => 60,
                           -command => [\&hook_run_lock, 'connect-target', $type, "$target:$p:$director" ],
                           pref 'service-pane-rms-button'
                           ) -> grid ( -column => 0,
                                       -row    => $i ++ ,
                                       -sticky => 'nw',
                                     ) ;
        }
        return ;
    }

    my @pref_button = pref 'service-pane-symm-button' ;

    my @map ;

    if ( $remote_image =~ /DIR_FILE_MAP:(.*)TRACES/ ||
         $remote_image =~ /DIR_FILE_MAP:(.*)/ ) {
        my $dirs = $1 ;
        while ( $dirs =~ /(\w+),([\da-f]+);/g ) {

            my ($emul, $map) = ($1, $2) ;
            my $j = 1 ;

            while ( $j < 10 and $map =~ s/([\da-f]{1,4})$// ) {

                # Perlon: had to break it into a list of shorts to avoid using BigInt
                my $mask = hex $1 ;

                my $i = 1 ;
                while ( $mask ) {

                    if ( $mask & 1 ) {

                        push @{ $map[ $i ][ $j ] }, $emul ;
                    }
                    $i ++ ;
                    $mask = $mask >> 1 ;
                }
                $j ++ ;
            }
        }
    }
    elsif ($remote_image =~ /DirMap:(.*?);/) {
        my $dirs = lc $1 ;
      # DirMap:D02a-s80f:D15a-s80f:D01b-s80f:D02b-s80f:D15b-s80f:D16b-s80f:D01c-s80f:D02c-s80f:D15c-s80f:D16c-s80f:D01d-s80f:D02d-s80f:D15d-s80f:D16d-s80f:D01a-d80f:D16a-d80f:
        while ($dirs =~ /([dl])(\d+)([a-h])\-(\w+)\:/g ) {
            my ($l, $i, $j, $emul) = ($1, $2, $3, $4) ;
            $map[$i][ord($j) - ord('a') + 1][$l eq 'l' ? 1 : 0] = $emul ;
        }
    }
    else {
        return if $remote_image =~ /please connect a remote /;
        return telthemloud "bad image: $remote_image" ;
    }

    my $hide_link_cpu = pref 'sgdb-hide-link-cpu' ;
    $hide_link_cpu and telthem "hiding the link cpu\n" ;
    foreach my $j ( 1 .. 10 ) {

        grep { $map[ $_ ] and $map[ $_ ][ $j ][ 0 ] } ( 1 .. 19 ) or next ;
        $f -> Label ( -text => (qw/0  a  b  c  d  e  f  g  h/)[$j],
                      ) -> grid ( -column => 0,
                                  -row    => 20 - 2 * $j ,
                                  -sticky => 'nw',
                                  ) ;

        next if $hide_link_cpu ;
        grep { $map[ $_ ] and $map[ $_ ][ $j ][ 1 ] } ( 1 .. 19 ) or next ;
        $f -> Label ( -text => (qw/0 la lb lc ld le lf lg lh/)[$j],
                      ) -> grid ( -column => 0,
                                  -row    => 20 - 2 * $j - 1 ,
                                  -sticky => 'nw',
                                  ) ;
    }

    foreach my $i ( 1 .. 19 ) {

        $map[ $i ] or next ;

        $f -> Label ( -text => $i,
                      ) -> grid ( -column => $i ,
                                  -row    => 0,
                                  -sticky => 'nw',
                                  ) ;

        foreach my  $j ( 1 .. 10 ) {

            $map[ $i ][ $j ][ 0 ] or next ;

            my $name =  join ('',
                              $target,
                              ':',
                              ($newformat ? sprintf ( "D%02d", $i) : $i),
                              (qw/0 a b c d e f g h/)[$j] );

            $dirnames{ lc $name } =
                $f -> Button ( -width => 4,
                               -text => $map[ $i ][ $j ][ 0 ],
                               -command => [\&runlocked, \&switch_director, $map[ $i ][ $j ][ 0 ], $name],
                               @pref_button
                               ) -> grid ( -column => $i,
                                           -row    => 20 - 2 * $j,
                                           -sticky => 'nw',
                                           ) ;

            next if $hide_link_cpu ;
            $map[ $i ][ $j ][ 1 ] or next ;

            $name =  join ('',
                           $target,
                           ':',
                           ($newformat ? sprintf ( "L%02d", $i) : "l$i" ),
                           (qw/0 a b c d e f g h/)[$j] );

            $dirnames{ lc $name } =
                $f -> Button ( -width => 4,
                               -text => $map[ $i ][ $j ][ 1 ],
                               -command => [\&runlocked, \&switch_director, $map[ $i ][ $j ][ 1 ], $name],
                               @pref_button
                               ) -> grid ( -column => $i,
                                           -row    => 20 - 2 * $j - 1 ,
                                           -sticky => 'nw',
                                           ) ;
        }
    }

    hook_run 'target-was-switched', $res ;
    hook_run 'new-swuch-target', $remote_addr ;
    hook_run 'new-chat-target', $target ;
    # Note: when this hook was executed by CommandPrompt, we didn't have $dirnames{ $cmd }
}

sub switch_director {

#     return &remotegui_switch_director if $remotegui ;

    my ( $emul, $cmd ) = @_ ;

    # first, try to get symbol-filename
    my $f = $filename || '#' ;

    # if ($f =~ /^\s*\#\s*(\w*)/ ) {
    # 
    #     $f = date_lookup_quick( lc $1 ) ;
    # }

    if ( ! $f or $f eq '#' ) {
        return ;
    }
    elsif ( -d $f ) {

        $f = "$f/$emul.elf*" ;
    }
    elsif ( -f $f ) {

      my $foo ;
      if  ( (( $foo = $f ) =~
             s{ol_[^/]+/[^/]+(\.[^/]+)\z}{ol_$emul/$emul$1} and -f $foo ) or
            (( $foo = $f ) =~
             s{[^/]+?(\_[^/]+?)\z}       {$emul$1}          and -f $foo ) or
            (( $foo = $f ) =~
             s{[^/]+?(\.[^/]+?)\z}       {$emul$1}          and -f $foo ) ) {

          $f = $foo;
      }
      else {
          $f = '' ;
      }
    }
    elsif ( $f =~ m{(.*)/} ) {

        $f = "$1/$emul.elf*" ;
    }
    else {

        $f = $ENV{PWD} . "/$emul.elf*" ;
    }

    $f =~ s/\/\//\//g ;         # always wanted to be an architect

    ( $f ) = sort { -M $a <=> -M $b || -s $b <=> -s $a } glob $f ;
    # perlon: get the newest or the largest file

    return telthemloud "cannot resolve file for '$emul'" unless $f ;
    return telthemloud "the file '$f' is not readable"   unless -r $f ;

    $filename = $f ;

    # this hook should create or raise the relevant gdb
    hook_run ('create-new-multi-gdb',
              'file' => $filename,
               ( ($gdbexec and lc ((split ' ', $gdbexec)[0]) ne 'auto' ) ?
                 ('execfile' => $gdbexec ) : () )
              ) ;

    target_symmetrix_chdir "$cmd $slc_cred $slc_pass" ;
}

sub target_was_switched {

    my $res = shift or return ;
    # This is the output of 'target symmetrix ..'

    $res =~ /^Detach \"(.*)\"/im and
        hook_run 'target-was-detached', 'dir', lc $1 ;

    my $sfile = gdb_cached 'file' ;
    return unless $sfile and -f $sfile ;
    # sanity check

    $res =~ /^Target .*\"(\S+).*\" \(cur/im or
        $res =~ /^Target .*\"(\S+).*\"/im   or
            return ;

    my $name = $target_was_switched = $1 ;
    $name =~ /(.*:)(.*)/ ;
    $name = lc( $1 . $2 ) ;
    hook_run 'switch-swuch-dir' => $2 ;

    my ($g1, $g2, $y1, $y2) = split ' ', pref 'service-pane-symm-colors' ;

    foreach my $b ( values %dirnames ) {
        $b -> configure ( -background => $y1,
                          -activebackground => $y2,
                          ) if $b -> cget  ( '-background' ) eq $g1 ;
    }

    $dirnames{ $name } -> configure ( -background => $g1,
                                      -activebackground => $g2,
                                      ) if exists $dirnames{ $name } ;

    if ( $name =~ /(.+?):(.+)/ ) {
        my ($adrr, $sock) = ($1, $2) ;
        my ($adr, $rem)   = $remote_addr =~ /^\s*(\S+)\s+(.*?)\s*$/ ;
        if ($adr  and
            $rem  and
            $sock and
            lc $adrr  eq lc $adr ) {
            $name = "$rem | $sock" ;
        }
    }

    hook_run 'set-title', 'target', $name ;
}

sub target_was_detached {

    return unless %dirnames ;
    my $type = shift ;
    my @buttons ;

    if    ( $type eq 'all' ) {

        localconfig 'cleanup' ;
        @buttons = values %dirnames ;
        $filename = '' ;
    }
    elsif ( $type eq 'file' ) {

        my $file = shift ;
        $file =~ m{([^/]+)\.elf[^/]*\z}i or return telme "what file is $file" ;
        my $emul  = $1 ;

        @buttons = grep { $_->cget( '-text' ) eq $emul } values %dirnames ;
    }
    elsif ( $type eq 'dir' ) {

        my $dir = lc shift ;
        @buttons = $dirnames{ $dir } if exists $dirnames{ $dir } ;
    }
    else {

        telme "unknown type: $type" ;
    }

    my @pref_button = pref 'service-pane-symm-button' ;
    foreach my $b ( @buttons ) {
        $b -> configure ( @pref_button ) ;
    }
}

sub fill_b_files {
    my $b = shift ;
    my $r = pref ( 'last-symbol-filename' ) ;
    $b -> delete(0, 'end' ) ;
    $b -> insert
      ( 0,
        $r,
        $r eq '#checksum' ? () : ('#checksum'),
#         $r ,
#         $r eq '#checksum' ? ('#qa') :
#         $r eq '#qa'       ? ('#checksum' ) :
#                             ('#checksum', '#qa') ,
#         ' --- recent files --- ',
        get_recent ('recent-symbol-files', 'recent/sgdb'),
      ) ;
}

sub fill_b_targets {

    # clear b_targets, fill history && hostfile
    my @items ;
    $b_targets -> delete( 0, 'end' ) ;
    if ( open F, $hostfile ) {
        @items = map { /\S/ ? (/^\s*(.*?)\s*$/) : () } <F> ;
        close F ;
    }
    else {
        telthem "can't open $hostfile: $!\n" ;
    }
    push @items,
      ' --- recent targets ---- ',
        get_recent 'recent-remote-addresses', 'recent/sgdb' ;

    $b_targets -> insert ( 0, @items ) ;
}

sub update_source_for_new_symbol_file {

    use File::Basename ;
    my $l = shift ;
    my $d = gdb_cached ( 'file' ) or return ;
    -d $d and return ;
    $d = dirname ($d ) || './' ;

    return if $last_symbol_file and $last_symbol_file eq $d  ;
    $last_symbol_file = $d ;

    $dir_cvs = $d ;
    if ( $dir_scratch and
         $dir_scratch =~ m[tmp/.sgdb_scratch.*/\S+] and
         glob "$dir_scratch/*" ) {

        recursive_clean_dir ($dir_scratch) ;
    }
    $dir_scratch = '' ;
    @source_directories = grep { ! /\(.*\)/ } @source_directories ;

    unshift @source_directories, "$d  (SymFile)" ;
    if ($d =~ /(.*)\/build/) {
        unshift @source_directories, "$1  (SymFile)" ;
    }

    # my $release = gdb_cached ('syren-v') || '' ;
    # my ($major, $minor) = $release =~ /\"\s*(\d+)\s+(\d+)/ ;

    # if    ( $minor and
    #         $minor !~ /^0*$/ and
    #         $d !~ m{/\.syren/\d+/rel\w+/} and
    #         scratch_directory( "${major}_${minor}" ) )  {
    # 
    #     unshift @source_directories, "  (Syren)" ;
    # 
    # }
    # elsif ( $d =~ m{/symdev.?/} and
    #         -e "$d/.scinfo" and
    #         scratch_directory ( $d =~ m|([^/]+)/$| ) ) {
    # 
    # 
    #     unshift @source_directories, "$dir_cvs  (CVS)"
    # }

    $l -> delete ( 0 => 'end' ) ;
    $l -> insert ( 0 => @source_directories ) ;
}

sub load_elf_file {

    my $sym_file = shift || find_file ( 0, 'Load Symbol File',
                                        $filename,
                                        -FPat => '*.elf*' ,
                                        ) ;
    $sym_file or return '' ;

    busy ;
    if (-T $sym_file ) { hook_run( 'open-source-file' ,    $sym_file ) }
    else               { activate_the_debugger( $sym_file ) }
    unbusy ;
    1 ;
}

sub new_symbol_file {

    my $f = shift or return;
    set_recent 'recent-symbol-files', ($filename = $f) , 'recent/sgdb' ;
}

sub new_target_remote {

    my ($msg) = $remote_addr =~ /^\s*[\w\.\-]*\s*(.*?)\s*$/ ;
    hook_run 'set-title', 'target', $msg || $remote_addr ;

    set_recent 'recent-remote-addresses', $remote_addr, 'recent/sgdb' ;
}

sub new_directroy_to_list {

    my $l = shift ;
    my $type = shift ;
    $type ||= $dir_type ;

    my @dirs ;

    if     ( $type eq 'Add Dir' ) {

        return telthemloud "$dir_reg : not a directory" unless $dir_reg and -d $dir_reg ;

        @source_directories = ( $dir_reg,
                                grep {$dir_reg ne $_} @source_directories
                                ) ;
    }
    # elsif ( $type eq 'Add Syren' ) {
    # 
    #     return unless scratch_directory ( 'syren' ) ;
    # 
    #     @source_directories = ( " (Syren)",
    #                             grep {! /\(Syren\)\s*$/ } @source_directories
    #                             ) ;
    # }
    # elsif ( $type eq 'Add CVS' ) {
    # 
    #     return telthemloud "$dir_cvs : not a directory"       unless -d  $dir_cvs ;
    #     return telthemloud "$dir_cvs/CVS/Entries: not exists" unless -T "$dir_cvs/CVS/Entries" ;
    # 
    #     return unless scratch_directory ( 'cvs' ) ;
    # 
    #     @source_directories = ( "$dir_cvs  (CVS)",
    #                             grep {! /\(CVS\)\s*$/   } @source_directories
    #                             ) ;
    # 
    # }
    elsif ( $type eq 'Add zip' ) {

        telthemloud 'TODO' ;
    }
    elsif ( $type eq 'Add ftp' ) {

        telthemloud 'TODO' ;
    }
    else {
        return telme "bad type: $type" ;
    }
    $l -> delete ( 0, 'end' ) ;
    $l -> insert ( 0, @source_directories ) ;
}

sub scratch_directory {

    return $dir_scratch if $dir_scratch ;

    my $ext = shift ;

    my $dir = pref 'last-scratch-directory' ;
    $dir =~ s/^\~/$ENV{HOME}/ ;

    if ( index ( $dir, 'sgdb_scratch' ) < 0 ) {

        # sanity check

        hook_run 'open-preferences-pane', 'last-scratch-directory' if
            askthem ("As a sanity check scratch directory must contain the string 'sgdb_scratch'.\n Use View -> Customize to edit the value 'last-scratch-directory'",
                     'Open Preferences', '     Cancel     ' ) eq
                         'Open Preferences' ;
        return ;
    }

    if (! -e $dir ) {

        return unless askthem ("$dir: does not exist.\n\n Create it?",
                               'Create Directory',
                               '     Cancel!    ') eq 'Create Directory' ;

        recursive_mkdir $dir ;
    }

    # Algo: done with asking (it's seems to confuse the user). I assume I'm allowed
    # to do anything under this dir and so help me god.

    my $display ;
    $display or ( $display ) = $ENV{DISPLAY} =~ /([^\s\:\/]+)/ ;
    $display or ( $display ) = $^O           =~ /([^\s\:\/]+)/ ;
    $display ||= 'localhost' ;
    $dir .= "/$display" ;
    $dir =~ s\/$\\ ;
    mkdir $dir ;                # Perlon: only if not exists

    -d $dir or return telthemloud "$dir: not a directory." ;

    $ext ||= 'tmp' ;
    $dir .= "/$ext" ;
    $dir =~ s\/$\\ ;
    mkdir $dir ;

    -d $dir or return telthemloud "$dir: not a directory." ;

    recursive_clean_dir ($dir) ;

    $dir_scratch = $dir ;
}

sub handle_clicked_glink {

    my $t = shift ;
    my $c = $t -> index ( 'current' ) ;

    my $i = -1  ;
    my $w ;
    while ( ++$i < 5 ) {

        # $w = $t -> get ("$c -$i c wordstart" => "$c -$i c wordend") ;
        $w = text_current_word $t, "$c -$i c" ;
        $w and $w =~ /\w/ and last ;
    }

    $t -> tagAdd ( 'glinked', "$c -$i c wordstart"=> "$c -$i c wordend" ) ;
    $t -> after (3000, [$t, 'tagRemove', 'glinked', '1.0', 'end' ]) ;

    if    ($w eq 'Browse_File') {

        my $f = find_file ( 0, 'Open Symbol File',
                            $filename,
                            -FPat => '*.elf*' ,
                            ) ;

        activate_the_debugger ( $f ) if $f ;
    }
    elsif ($w eq 'Set_Default_File' ) {

        telthem "'$filename' will be default symbol-file for next sessions" ;
        pref_set 'last-symbol-filename' => $filename ;
    }
    elsif ($w eq 'From_File') {

        my $f = find_file ( 0, 'Load Targets List',
                            $ENV{HOME} . '/.sgdbhosts' ,
                          ) or return ;
        $hostfile = $f ;
    }
    elsif ($w eq 'Edit_File') {

        hook_run ('open-file-for-edit', $hostfile, [\&telthem, "$hostfile saved"] ) ;
    }
    elsif ( $w eq 'Set_Default_Debugger' ) {

        telthem "$gdbexec will be default debugger for next sessions" ;
        pref_set 'last-gdb-exec' => $gdbexec ;
    }
    elsif ( $w eq 'QA_lookup' ) {

        qa_lookup() ;
    }
    elsif ( $w eq 'Date_lookup' ) {

        date_lookup() ;
    }
    elsif ( $w eq 'Disconnect' ) {

        gdb_exec_lock 'detach' ;
    }
    elsif ( $w eq 'Disconnect_All' ) {

      hook_run_lock 'exec-multi-target-cmd', 1, 1, 'detach' ;
      hook_run      'target-was-detached', 'all' ;
    }
    elsif ( $w eq 'Add_To_File' ) {

        if ( open FILE, ">>$hostfile" ) {

            print FILE "\n", $remote_addr ;
            close FILE ;
            telthem     "added '$remote_addr' to $hostfile list" ;
        }
        else {
            telthemloud "cannot write to $hostfile: $!" ;
        }
    }
    elsif ( $w eq 'Connect_All' ) {

        return telthemloud "No valid directors" unless %dirnames ;
        foreach my $dir (sort keys %dirnames ) {
            $dirnames{ $dir } -> invoke() ;
        }
    }
    elsif ( $w eq 'Connect_Same' ) {

        return telthemloud "what file is '$filename'?" unless $filename =~ m{([^/]+)\.elf[^/]*\z}i ;
        my $emul  = $1 ;
        return telthemloud "No valid directors" unless %dirnames ;

        foreach my $b ( values %dirnames ) {
            $b -> invoke() unless index $emul, $b -> cget( '-text' ) ;
        }
    }
    elsif ( $w eq 'tstart'   or
            $w eq 'tstop'    or
            $w eq 'tstatus'  or
            $w eq 'tfind'
            ) {

        # Todo: elaboration needed. tfind can stop at first hit etc.
        hook_run_lock 'exec-multi-target-cmd', $allgdb, $alltar, $w ;
    }
    elsif ( $w eq 'Set_Default_Address' ) {
        telthem "'$remote_addr' will be default remote address for next sessions" ;
        pref_set 'last-remote-address' => $remote_addr ;
    }
    elsif ( $w eq 'Pre_SymmIp' ) {

        busy ;
        my $msg = localconfig 'call-symmnat', $remote_addr =~ /^\s*(\S+)/ ;
        unbusy ;
        if ( $msg =~ /^Error/ ) {
            telthemloud $msg ;
        }
        else {
            telthem     $msg ;
        }
    }
    elsif ( $w eq 'Add_To_List' ) {
        pref_set 'last-gdb-exec-list' =>
          join ';',
            $gdbexec,
              grep {$_ ne $gdbexec }
                split /\s*;\s*/,
                  pref 'last-gdb-exec-list' ;
    }
}

sub eval_sgdbinit {

    my $file = getfilename args ('initfile') ||  pref ('last-init-file') ;
    return unless $file and -e $file ;
    open F,$file or return telthemloud "can't open $file: $!" ;
    my $code = join '', <F> ;
    close F ;
    $mainwindow -> afterIdle ( sub {
                                   busy ;
                                   eval $code;
                                   telthemloud "$file error:\n $@" if $@ ;
                                   unbusy ;
                                  } ) ;
}

1
